home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 011-020 / amok12 / module / arraysort.mod < prev    next >
Text File  |  1993-11-04  |  2KB  |  77 lines
  1. (*---------------------------------------------------------------------------
  2.     :Program.    ArraySort.mod
  3.     :Author.     Bernd Preusing
  4.     :Address.    Gerhardstr. 16  D-2200 Elmshorn
  5.     :Phone.      04121/22486
  6.     :Shortcut.   [bep]
  7.     :Version.    1.0
  8.     :Date.       21-Oct-88
  9.     :Copyright.  PD
  10.     :Language.   Modula-II
  11.     :Translator. M2Amiga
  12.     :Imports.    ---
  13.     :UpDate.     
  14.     :Contents.   universal array sorter
  15.     :Remark.     
  16. ---------------------------------------------------------------------------*)
  17. IMPLEMENTATION MODULE ArraySort;
  18.  
  19. FROM SYSTEM IMPORT
  20.     ADDRESS, ADR;
  21.  
  22. FROM Arts IMPORT
  23.     StkChk, Assert;
  24.  
  25. (* TYPE
  26.      prLess = PROCEDURE(ADDRESS,ADDRESS):BOOLEAN;
  27. *)
  28.  
  29. (* $R- $V- $S- *) (* kann beides unmöglich auftreten! *)
  30.  
  31. (* Implementiert als HeapSort, da nur wenig langsamer als Quicksort, aber
  32.    im schlechtesten Fall schneller und Code viel kürzer *)
  33.  
  34. PROCEDURE Sort(VAR arr:ARRAY OF ADDRESS;
  35.         count:LONGINT;
  36.                 less: prLess);
  37. VAR
  38.   d,r,i,j: LONGINT;
  39.   h: ADDRESS;
  40.   ok: BOOLEAN;
  41.  
  42. BEGIN
  43.   StkChk(-50); (* nur einmal prüfen reicht! *)
  44.   Assert((count>0) AND (count<=(HIGH(arr)+1)),
  45.         ADR('Sort: falscher count-Parameter'));
  46.   d:=count DIV 2;
  47.   r:=count-1;
  48.   WHILE r>0 DO
  49.     IF d<=0 THEN
  50.       h:=arr[0]; arr[0]:=arr[r]; arr[r]:=h;
  51.       i:=0;
  52.       DEC(r)
  53.     ELSE
  54.       DEC(d);
  55.       i:=d
  56.     END;
  57.     h:=arr[i];
  58.     ok:=FALSE;
  59.     j:=2*i;
  60.     WHILE NOT ok AND (r>=j) DO
  61.       IF (j<r) AND (less(arr[j],arr[j+1])) THEN
  62.         INC(j)
  63.       END;
  64.       IF less(h,arr[j]) THEN
  65.         arr[i]:=arr[j];
  66.         i:=j;
  67.         j:=2*i (* guter Compiler, macht daraus ASL #1,xx! *)
  68.       ELSE
  69.         ok:=TRUE
  70.       END;
  71.     END; (* while not .. *)
  72.     arr[i]:=h
  73.   END; (* while r>0 *)
  74. END Sort;
  75.  
  76. END ArraySort.mod
  77.